home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 1992 August / info-mac-1992.iso / Applications (app) / Image 1.44 / Macros / Stacks < prev    next >
Text File  |  1992-03-11  |  11KB  |  539 lines
  1. {This file contains macros that work with stacks.}
  2.  
  3.  
  4. macro 'Add Slice [A]';    begin AddSlice end;
  5. macro 'Delete Slice [D]'; begin DeleteSlice end;
  6.  
  7.  
  8. procedure CheckForStack;
  9. begin
  10.   if nSlices=0 then begin
  11.     PutMessage('This window is not a stack');
  12.     exit;
  13.   end;
  14. end;
  15.  
  16.  
  17. macro 'Run Movie';
  18. var
  19.   i:integer;
  20. begin
  21.   CheckForStack;
  22.   i:=0;
  23.   repeat
  24.     i:=i+1;
  25.     if i>nSlices then i:=1;
  26.     SelectSlice(i);
  27.   until button;
  28. end;
  29.  
  30.  
  31. macro 'Smooth';
  32. var
  33.   i:integer;
  34. begin
  35.   CheckForStack;
  36.   for i:= 1 to nSlices do begin
  37.     SelectSlice(i);
  38.     SetOption; Smooth;
  39.   end;
  40. end;
  41.  
  42.  
  43. macro 'Sharpen';
  44. var
  45.   i:integer;
  46. begin
  47.   CheckForStack;
  48.   for i:= 1 to nSlices do begin
  49.     SelectSlice(i);
  50.     SetOption; Smooth;
  51.     SetOption; Sharpen;
  52.   end;
  53. end;
  54.  
  55.  
  56. macro 'Invert';
  57. var
  58.   i:integer;
  59. begin
  60.   CheckForStack;
  61.   for i:= 1 to nSlices do begin
  62.     SelectSlice(i);
  63.     Invert;
  64.   end;
  65. end;
  66.  
  67.  
  68. macro 'Apply LUT';
  69. var
  70.   i,stack,slices:integer;
  71. begin
  72.   CheckForStack;
  73.   stack:=PicNumber;
  74.   slices:=nSlices;
  75.   Duplicate('Temp');
  76.   for i:= 1 to slices do begin
  77.     SelectPic(stack);
  78.     SelectSlice(i);
  79.     ApplyLut;
  80.     SelectPic(nPics);
  81.     if i<>slices then PropagateLut;
  82.   end;
  83.   Dispose(nPics);
  84. end;
  85.  
  86.  
  87. macro 'Remove 0 and 255';
  88. {
  89. Changes 0 to 1 and 255 to 254 in all slices. We want to do this because
  90. pixel values of 0(which always displays as white) and 255(always
  91. displays as black) cause problems when pseudo-coloring images.
  92. }
  93. var
  94.   i:integer;
  95. begin
  96.   CheckForStack;
  97.   for i:= 1 to nSlices do begin
  98.     SelectSlice(i);
  99.     ChangeValues(0,0,1);
  100.     ChangeValues(255,255,254);
  101.   end;
  102. end;
  103.  
  104.  
  105. procedure flip(vertical:boolean);
  106. var
  107.   i:integer;
  108. begin
  109.   CheckForStack;
  110.   for i:= 1 to nSlices do begin
  111.     SelectSlice(i);
  112.     if vertical
  113.       then FlipVertical
  114.       else FlipHorizontal;
  115.   end;
  116. end;
  117.  
  118. macro 'Flip Vertical';   begin flip(true) end;
  119. macro 'Flip Horizontal'; begin flip(false) end;
  120.  
  121.  
  122. procedure CheckForSelection;
  123. var 
  124.   x1,y1,x2,y2,LineWidth:integer;
  125. begin
  126.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  127.   GetLine(x1,y1,x2,y2,LineWidth);
  128.   if (RoiWidth=0) or (x1>=0) then begin
  129.     PutMessage('Please make a rectangular selection.');
  130.     exit;
  131.   end;
  132. end;
  133.  
  134.  
  135. macro 'Clear Outside';
  136. var
  137.   i:integer;
  138.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  139. begin
  140.   CheckForStack;
  141.   CheckForSelection;
  142.   for i:= 1 to nSlices do begin
  143.     SelectSlice(i);
  144.     Copy;
  145.     SelectAll;
  146.     Clear;
  147.     RestoreRoi;
  148.     Paste;
  149.     RestoreRoi;
  150.   end;
  151. end;
  152.  
  153.  
  154. procedure Rotate(left:boolean);
  155. var
  156.   i,OldStack,NewStack:integer;
  157.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  158.   N,NewWidth:integer;
  159.   ScaleFactor:real;
  160.   OneToOne:boolean;
  161. begin
  162.   CheckForStack;
  163.   SelectAll;
  164.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  165.   OldStack:=PicNumber;
  166.   N:=nSlices;
  167.   SetNewSize(RoiHeight,RoiWidth);
  168.   MakeNewStack('Stack');
  169.   NewStack:=PicNumber;
  170.   SelectPic(OldStack);
  171.   for i:= 1 to N do begin
  172.     SelectSlice(1);
  173.     if left
  174.       then RotateLeft(true)
  175.       else RotateRight(true);
  176.     SelectAll;
  177.     Copy;
  178.     SelectPic(NewStack);
  179.     if i<>1 then AddSlice;
  180.     Paste;
  181.     ChoosePic(nPics);
  182.     Dispose;
  183.     SelectPic(OldStack);
  184.     DeleteSlice;
  185.   end;
  186.   Dispose;
  187. end;
  188.  
  189. macro 'Rotate Left';  begin rotate(true) end;
  190. macro 'Rotate Right'; begin rotate(false) end;
  191.  
  192.  
  193. procedure CropAndScale(fast:boolean);
  194. var
  195.   i,OldStack,NewStack:integer;
  196.   RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  197.   N,NewWidth:integer;
  198.   ScaleFactor:real;
  199.   OneToOne:boolean;
  200. begin
  201.   CheckForStack;
  202.   CheckForSelection;
  203.   SaveState;
  204.   OldStack:=PicNumber;
  205.   N:=nSlices;
  206.   ScaleFactor:=GetNumber('Scale factor[1.0]:',1.0);
  207.   OneToOne:=ScaleFactor=1.0;
  208.   NewWidth:=round(RoiWidth*ScaleFactor);
  209.   if odd(NewWidth) then begin
  210.     NewWidth:=NewWidth-1;
  211.     ScaleFactor:=NewWidth/RoiWidth;
  212.   end;
  213.   SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  214.   MakeNewStack('Stack');
  215.   NewStack:=PicNumber;
  216.   if not OneToOne then begin
  217.     if fast 
  218.       then SetScaling('Nearest; Create New Window')
  219.       else SetScaling('Bilinear; Create New Window');
  220.   end;
  221.   SelectPic(OldStack);
  222.   for i:= 1 to N do begin
  223.     SelectSlice(1);
  224.     if OneToOne then Duplicate('Temp')
  225.       else ScaleAndRotate(ScaleFactor,ScaleFactor,0);
  226.     SelectAll;
  227.     Copy;
  228.     SelectPic(NewStack);
  229.     if i<>1 then AddSlice;
  230.     Paste;
  231.     ChoosePic(nPics);
  232.     Dispose;
  233.     SelectPic(OldStack);
  234.     DeleteSlice;
  235.   end;
  236.   Dispose;
  237.   RestoreState;
  238. end;
  239.  
  240.  
  241. macro 'Crop and Scale-Fast';   begin CropAndScale(true); end;
  242. macro 'Crop and Scale-Smooth'; begin CropAndScale(false); end;
  243.  
  244.  
  245. macro 'Delete Even Slices';
  246. var
  247.   n:integer;
  248. begin
  249.   CheckForStack;
  250.   SelectSlice(2);
  251.   repeat
  252.     DeleteSlice;
  253.     n:=SliceNumber;
  254.     n:=n+2;
  255.     if n>nSlices then exit;
  256.     SelectSlice(n);
  257.    until false;
  258. end;
  259.  
  260.  
  261. macro 'Replicate Slices';
  262. var
  263.   n,i,RepFactor:integer;
  264. begin
  265.   CheckForStack;
  266.   RepFactor:=GetNumber('Replication factor(2,3,4,5,etc):',2);
  267.   n:=nSlices;
  268.   repeat
  269.     SelectSlice(n);
  270.     SelectAll;
  271.     Copy;
  272.     for i:=2 to RepFactor do begin
  273.       AddSlice;
  274.       Paste;
  275.     end;
  276.     n:=n-1;
  277.    until n=0;
  278.    KillRoi;
  279. end;
  280.  
  281.  
  282. macro 'Test';
  283. var
  284.   n,y,width,height:integer;
  285. begin
  286.   CheckForStack;
  287.   n:=nSlices-1;
  288.   GetPicSize(width,height);
  289.   repeat
  290.     SelectSlice(n);
  291.     SelectAll;
  292.     Copy;
  293.     AddSlice;
  294.     Paste;
  295.     KillRoi;
  296.     SelectSlice(n+1);
  297.     for y:=0 to height-1 do begin
  298.       ChooseSlice(n);
  299.       GetRow(0,height-y,width);
  300.       ChooseSlice(n+2);
  301.       PutRow(0,y,width);
  302.     end;
  303.     n:=n-1;
  304.    until n=0;
  305. end;
  306.  
  307.  
  308. macro 'Merge Two Stacks';
  309. {
  310. Combines two stacks(w1xh1xd1 and w2xh2xd2) to create a new
  311. w1+w2 x max(h1,h2) x max(d1,d2) stack. For example, a 256x256x40
  312. and a 256x256x30 stack would be combined into one 512x256x40 stack.
  313. }
  314. var
  315.   i,w1,w2,w3,h1,h2,h3,d1,d2,d3:integer;
  316. begin
  317.   SaveState;
  318.   if nPics<>2 then begin
  319.     PutMessage('This macro operates on exactly two stacks.');
  320.     exit;
  321.   end;
  322.   SelectPic(1);
  323.   GetPicSize(w1,h1);
  324.   d1:=nSlices;
  325.   SelectPic(2);
  326.   GetPicSize(w2,h2);
  327.   d2:=nSlices;
  328.   if d1>=d2
  329.     then d3:=d1
  330.     else d3:=d2;
  331.   if d3=0 then begin
  332.     PutMessage('Both images must be stacks.');
  333.     exit;
  334.   end;
  335.   w3:=w1+w2;
  336.   if h1>=h2
  337.     then h3:=h1
  338.     else h3:=h2;
  339.   SetNewSize(w3,h3);
  340.   MakeNewStack('Merged');
  341.   for i:=1 to d3 do begin
  342.     SelectPic(1);
  343.     SelectSlice(1);
  344.     SelectAll;
  345.     Copy;
  346.     DeleteSlice;
  347.     SelectPic(3);
  348.     MakeRoi(0,0,w1,h1);
  349.     Paste;
  350.     SelectPic(2);
  351.     SelectSlice(1);
  352.     SelectAll;
  353.     Copy;
  354.     DeleteSlice;
  355.     SelectPic(3);
  356.     MakeRoi(w1,0,w2,h2);
  357.     Paste;
  358.     if i<d3 then AddSlice;
  359.   end;
  360.   SelectPic(1);
  361.   Dispose;
  362.   SelectPic(1);
  363.   Dispose;
  364.   RestoreState;
  365. end;
  366.  
  367.  
  368. macro 'Save Slices as files';
  369. {
  370. This macro saves the slices in a stack as individual TIFF or PICT files using
  371. names of the form needed by Apple's Convert to [QuickTime]Movie utility.
  372. To specify the file type, checked either TIFF or PICT in the SaveAs dialog
  373. box, which should only appear once.
  374. }
  375. var
  376.   i,stack:integer;
  377. begin
  378.   CheckForStack;
  379.   stack:=PicNumber;
  380.   for i:= 1 to nSlices do begin
  381.     SelectPic(stack);
  382.     SelectSlice(i);
  383.     Duplicate('Frame.',i:2);
  384.     SaveAs;
  385.     {Export;}
  386.     Dispose;
  387.   end;
  388. end;
  389.  
  390.  
  391. macro 'Windows to Stack';
  392. {Unlike the menu command of the same name, the windows do not}
  393. {all need to be the same size.}
  394. var
  395.   i,width,height,MinWidth,MinHeight,n,stack:integer;
  396.   isStack:boolean;
  397. begin
  398.   if nPics<=1 then begin
  399.     PutMessage('At least two images must be open.');
  400.     exit;
  401.   end;
  402.   MinWidth:=9999;
  403.   MinHeight:=9999;
  404.   isStack:=false;
  405.   for i:=1 to nPics do begin
  406.     SelectPic(i);
  407.     GetPicSize(width,height);
  408.     if width<MinWidth then MinWidth:=width;
  409.     if height<MinHeight then MinHeight:=height;
  410.     isStack:=isStack or (nSlices>0);
  411.   end;
  412.   if isStack then begin
  413.     PutMessage('This macro does not work with stacks.');
  414.     exit;
  415.   end;
  416.   if odd(MinWidth) then MinWidth:=MinWidth-1;
  417.   n:=nPics;
  418.   SaveState;
  419.   SetNewSize(MinWidth,MinHeight);
  420.   MakeNewStack('Stack');
  421.   stack:=nPics;
  422.   for i:=1 to n do begin
  423.     SelectPic(1);
  424.     MakeRoi(0,0,MinWidth,MinHeight);
  425.     copy;;
  426.     Dispose;
  427.     SelectPic(nPics);
  428.     paste;
  429.     if i<>n then AddSlice;
  430.   end;
  431.   KillRoi;
  432.   RestoreState;
  433. end;
  434.  
  435.  
  436. macro 'Make Cone';
  437. var
  438.   i,size,margin,MaxRadius,r,r2,center,length,color,temp:integer;
  439. begin
  440.   size:=64;
  441.   margin:=5;
  442.   color:=100;
  443.   SaveState;
  444.   SetBackgroundColor(255); {Black}
  445.   SetNewSize(size,size);
  446.   MakeNewWindow('Temp'); {Work-around for bug fixed in V1.42}
  447.   temp:=nPics;
  448.   MakeNewStack('Cone');
  449.   for i:=1 to margin do AddSlice;
  450.   MaxRadius:=(size-2*margin)/2;
  451.   center:=size div 2;
  452.   length:=size-2*margin-1;
  453.   for i:=1 to length do begin
  454.     AddSlice;
  455.     r:=MaxRadius*(i/length);
  456.     MakeOvalRoi(center-r,center-r,r*2,r*2);
  457.     SetForegroundColor(color);
  458.     Fill;
  459.     if (i>length/2) and (i<(length-margin)) then begin
  460.       r2:=MaxRadius/6;
  461.       MakeOvalRoi(center-2.125*r2,center-1.3*r2,r2*2,r2*2);
  462.       SetForegroundColor(color-25);
  463.       Fill;
  464.       MakeOvalRoi(center+0.625*r2,center-0.7*r2,r2*2,r2*2);
  465.       SetForegroundColor(color+25);
  466.       Fill;
  467.     end;
  468.   end;
  469.   KillRoi;
  470.   for i:=1 to margin do AddSlice;
  471.   SelectPic(temp);
  472.   Dispose;
  473.   RestoreState;
  474. end;
  475.  
  476.  
  477. procedure DoReslicing(horizontal:boolean);
  478. var
  479.   OutputSpacing,stack1,stack2,width,height:integer;
  480.   RoiLeft,RoiTop,RoiWidth,RoiHeight,loc,max:integer;
  481.   InputSpacing:real;
  482.   FirstTime:boolean;
  483. begin
  484.   CheckForStack;
  485.   CheckForSelection;
  486.   SaveState;
  487.   SetBackground(0);
  488.   SetBackground(255);
  489.   stack1:=PicNumber;
  490.   InputSpacing:=GetSliceSpacing;
  491.   if InputSpacing<=0 then InputSpacing:=1;
  492.   InputSpacing:=GetNumber('Input Slice Spacing:',InputSpacing);
  493.   SetSliceSpacing(InputSpacing);
  494.   OutputSpacing:=round(InputSpacing+0.25);
  495.   OutputSpacing:=round(GetNumber('Output Slice Spacing:',OutputSpacing));
  496.   FirstTime:=true;
  497.   GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  498.   if horizontal then begin
  499.     loc:=RoiTop+OutputSpacing;
  500.     max:=RoiTop+RoiHeight;
  501.   end else begin
  502.     loc:=RoiLeft+OutputSpacing;
  503.     max:=RoiLeft+RoiWidth;
  504.   end;
  505.   while loc<max do begin
  506.     ChoosePic(stack1);
  507.     if horizontal
  508.       then MakeLineRoi(RoiLeft,loc,RoiLeft+RoiWidth,loc)
  509.       else MakeLineRoi(loc,RoiTop,loc,RoiTop+RoiTop+RoiHeight);
  510.     Reslice;
  511.     SelectAll;
  512.     Copy;
  513.     GetPicSize(width,height);
  514.     Dispose;
  515.     if FirstTime then begin
  516.       SetNewSize(width,height);
  517.       MakeNewStack(OutputSpacing:1:2);
  518.       SetSliceSpacing(OutputSpacing);
  519.       stack2:=PicNumber;
  520.     end;
  521.     ChoosePic(stack2);
  522.     if not FirstTime then AddSlice;
  523.     Paste;
  524.     loc:=loc+OutputSpacing;
  525.     FirstTime:=false;
  526.   end;
  527.   SelectPic(stack1);
  528.   KillRoi;
  529.   SelectPic(stack2);
  530.   KillRoi;
  531.   RestoreState;
  532. end;
  533.  
  534.  
  535. macro 'Reslice Horizontally'; begin DoReslicing(true) end;
  536. macro 'Reslice Vertically';   begin DoReslicing(false) end;
  537.  
  538.  
  539.